home *** CD-ROM | disk | FTP | other *** search
/ Meeting Pearls 4 / Meeting Pearls Vol. IV (1996)(GTI - Schatztruhe)[!].iso / Pearls / dev / Oberon / OberonV4 / system / AmigaDiskFont.Mod (.txt) < prev    next >
Oberon Text  |  1994-06-23  |  4KB  |  97 lines
  1. Syntax10.Scn.Fnt
  2. Syntax10b.Scn.Fnt
  3. MODULE AmigaDiskFont;
  4. IMPORT SYSTEM, A := AmigaBase, e := AmigaExec, g := AmigaGraphics;
  5. CONST
  6.  diskFontName*="diskfont.library";
  7.  maxFontPath * = 256;    (* including null terminator *)
  8.   FontContentsPtr * = UNTRACED POINTER TO FontContents;
  9.   FontContents * = STRUCT
  10.     fileName * : ARRAY maxFontPath OF CHAR;
  11.     ySize * : INTEGER;
  12.     style * : SHORTSET;
  13.     flags * : SHORTSET;
  14.   END;
  15.   TFontContentsPtr * = UNTRACED POINTER TO TFontContents;
  16.   TFontContents * = STRUCT
  17.     fileName * : ARRAY maxFontPath-2 OF CHAR;
  18.     tagCount * : INTEGER;
  19.     (*
  20.      *  if tfc_TagCount is non-zero, tfc_FileName is overlayed with
  21.      *  Text Tags starting at:  (struct TagItem * )
  22.      *      &tfc_FileName[MAXFONTPATH-(tfc_TagCount*sizeof(struct TagItem))]
  23.      *)
  24.     ySize * : INTEGER;
  25.     style * : SHORTSET;
  26.     flags * : SHORTSET;
  27.   END;
  28. CONST
  29.   fchId     * = 00F00H;  (* FontContentsHeader, then FontContents *)
  30.   tfchId    * = 00F02H;  (* FontContentsHeader, then TFontContents *)
  31.   FontContentsHeaderPtr * = UNTRACED POINTER TO FontContentsHeader;
  32.   FontContentsHeader * = STRUCT
  33.     fileID * : INTEGER;         (* FCH_ID *)
  34.     numEntries * : INTEGER;     (* the number of FontContents elements *)
  35.  (* fc  * : ARRAY numEntries OF FontContents or
  36.     tfc * : ARRAY numEntries OF TFontContents    *)
  37.   END;
  38. CONST
  39.   dfhId       * = 00F80H;
  40.   maxFontName * = 32;     (* font name including ".font\0" *)
  41.   DiskFontHeaderPtr * = UNTRACED POINTER TO DiskFontHeader;
  42.   DiskFontHeader * = STRUCT (df * : e.Node)  (* node to link disk fonts *)
  43.     (* the following 8 bytes are not actually considered a part of the  *)
  44.     (* DiskFontHeader, but immediately preceed it. The NextSegment is   *)
  45.     (* supplied by the linker/loader, and the ReturnCode is the code    *)
  46.     (* at the beginning of the font in case someone runs it...          *)
  47.     (*   ULONG dfh_NextSegment;                 \* actually a BPTR      *)
  48.     (*   ULONG dfh_ReturnCode;                  \* MOVEQ #0,D0 : RTS    *)
  49.     (* here then is the official start of the DiskFontHeader...         *)
  50.     fileID * : INTEGER;         (* DFH_ID *)
  51.     revision * : INTEGER;       (* the font revision *)
  52.     segment * : e.BPTR;         (* the segment address when loaded *)
  53.     name * : ARRAY maxFontName OF CHAR; (* the font name (null terminated) *)
  54.     tf * : g.TextFont;          (* loaded TextFont structure *)
  55.   END;
  56. CONST
  57.   memory  * = 0;
  58.   disk    * = 1;
  59.   scaled  * = 2;
  60.   tagged  * = 16;       (* return TAvailFont *)
  61.   AvailFontPtr * = UNTRACED POINTER TO AvailFont;
  62.   AvailFont * = STRUCT
  63.     type * : SET;            (* MEMORY, DISK, or SCALED *)
  64.     attr * : g.TextAttr;     (* text attributes for font *)
  65.   END;
  66.   TAvailFontPtr * = UNTRACED POINTER TO TAvailFont;
  67.   TAvailFont * = STRUCT
  68.     type * : SET;          (* MEMORY, DISK, or SCALED *)
  69.     attr * : g.TTextAttr;  (* text attributes for font *)
  70.   END;
  71.   AvailFontsHeaderPtr * = UNTRACED POINTER TO AvailFontsHeader;
  72.   AvailFontsHeader * = STRUCT
  73.     numEntries * : INTEGER;      (* number of AvailFont elements *)
  74.  (* af  * : ARRAY numEntries OF AvailFont or
  75.     taf * : ARRAY numEntries OF TAvailFont   *)
  76.   END;
  77.  diskFontBase*: e.LibraryPtr;
  78.  diskFontVersion-:INTEGER;
  79. PROCEDURE OpenDiskFont*(VAR textAttr: g.TextAttr): g.TextFontPtr;
  80.  r:A.Regs;
  81. BEGIN
  82.  r.a[0] := SYSTEM.ADR(textAttr);
  83.  A.LibCall(diskFontBase,-30,r);
  84.  RETURN SYSTEM.VAL(g.TextFontPtr, r.d[0])
  85. END OpenDiskFont;
  86. PROCEDURE Init;
  87.     LibraryPtr=POINTER TO e.Library;
  88.     lib:LibraryPtr;
  89. BEGIN
  90.     diskFontBase := e.OpenLibrary(diskFontName,37);
  91.     IF diskFontBase=0 THEN HALT(99) END;
  92.     lib:=SYSTEM.VAL(LibraryPtr,diskFontBase);
  93.     diskFontVersion:=lib.version;
  94. END Init;
  95. BEGIN Init
  96. END AmigaDiskFont.
  97.